#!/usr/bin/perl

# -*- mode: perl; cperl-continued-brace-offset: -4; indent-tabs-mode: nil; -*-
# vim:shiftwidth=2:tabstop=8:expandtab:textwidth=78:softtabstop=4:ai:

#
# Post-commit hook to gather metadata about keys and write a data-dictionary
# for your repository.
#
# pdibowitz Mon Dec 17 17:30:23 PST 2007
#

use strict;
use warnings;

use SVN::Core;
use SVN::Repos;
use SVN::Fs;
use SVN::Ra;
use IO::Scalar;
use YAML::Syck;
use File::Basename;
use Data::Dumper;

use lib '../lib/';
use Spine::Publisher::ChangeHarvester;

use constant DATA_FILE => '/tmp/spine.metadata';
use constant HTML_FILE => '/tmp/spine.html';
use constant REPO_PATH => '/home/phil/work/repo';

my $debug = 0;

sub debug
{
    my $msg = shift;
    print STDERR "DEBUG: $msg\n" if ($debug);
}

#
# Read in our state file so we don't have to parse the whole tree each time
#
sub read_existing_data
{
    my $data = {};
    if (-e DATA_FILE) {
        $data = YAML::Syck::LoadFile(DATA_FILE);
    } else {
        $data->{rev} = 1;
    }
    return $data;
}

#
# Generate a list of things that changed between the last release and this one
#
sub generate_delta
{
    my ($repo_path, $base_rev, $rev) = @_;
    # Create our various objects for generating the diff
    my $repos_ptr = SVN::Repos::open($repo_path);
    my $fs_ptr = SVN::Repos::fs($repos_ptr);
    my $root = SVN::Fs::revision_root($fs_ptr, $rev);
    my $base_root = SVN::Fs::revision_root($fs_ptr, $base_rev);
    my $editor = new Spine::Publisher::ChangeHarvester();

    #
    # HERE YE! HERE YE! READ THIS NOW!!!
    #
    # The docs for the svn perl bindings are WRONG in MANY places. This code
    # works thanks to digging into all of the XS code in the perl-bindings and
    # the svn libraries themselves. All relevent data has been put here for
    # ease of future coders who need to work on this, or any other perl-svn
    # code. READ IT!
    #
    # The C code expects the following 14 arguments
    # svn_repos_dir_delta(src_root,src_parent_dir,src_entry,
    #			tgt_root,tgt_path,
    #			editor,edit_baton,
    #			authz_read_func,authz_read_baton,
    #			text_deltas,recurse,entry_props,ignore_ancestry,pool);
    #			base root, base_dir, arg3
    #
    # However, the perl code DOES NOT accept all of these arguements. It fills
    # in many of them for you, as the docs indicate. However, the ones which
    # are required aren't exactly as described in the docs.... here is the
    # mapping.  Perl arg number starts at 0 because that's the way XS works
    # (you access arguments using ST(0) - ST(n). However, the c code is called
    # using the variables arg1 - arg14. Hence those are numbered 1-14 here.
    #
    # PERL_ARG#  C_ARG  ARG 
    # 0          1      base root
    # 1          2      base dir
    # 2          3      base entry    *** SEE NOTE 1 BELOW!!!
    # 3          4      tgt root
    # 4          5      tgt dir
    # 5          6      editor
    #            7      e baton       *** SEE NOTE 2 BELOW!!!
    #            8      authz func
    # 6          9      authz baton   *** SEE NOTE 3 BELOW!!!
    # 7-10       10-13  flags
    #            14     apr pool      *** APR pools are automagically handled
    #                                     by the perl code
    # 
    # NOTE 1: Despite the docs, base_entry CANNOT BE UNDEF!! It MUST be
    #         defined or you will segfault.
    #
    # NOTE 2: You pass in an editor (SVN::Delta::Editor) object ONLY. The perl
    #         code will call make_editor for you, thus generating an
    #         editor_baton. You CAN NOT pass an editor baton in!
    #
    # NOTE 3: The perl code has it's own authz callback function which it
    #         passes in - the baton you pass in is actually YOUR OWN CALLBACK
    #         - they're call back will pass your call back in as it's baton,
    #         and then call your callback for you. This means YOU DO NOT GET A
    #         BATON.
    #
 
                            # base_root, base_dir, base_entry
    SVN::Repos::dir_delta(  $base_root, '', '',
                            # target_root, target_dir
                            $root, '',
                            # editor
                            $editor,
                            # authzcb_baton
                            undef,
                            # 4 flags
                            0, 1, 0, 0);

    return $editor;
}

#
# Given a list of chagnes, return only those we care about
#
sub grab_config_keys
{
    my $editor = shift;

    my $keys = {};
    foreach my $e (keys(%{$editor->{changes}})) {
        if ($e =~ /(?<!rubix\-)config\//) {
            $keys->{$e} = undef;
        }
    }
    return $keys;
}

#
# For each value we process it. If it's a tag, we add it to both the
# forward and reverse maps for tags. For everything else, we just add
# it to the standard metadata. Further special actions for special metdata
# types can be added later.
#
sub process_val
{
    my ($data, $key, $md_key, $md_val) = @_;

    my $keyname = basename($key);
    my $location = dirname($key);
    if ($$md_key eq 'tags') {
        my @array = split(/\s*,\s*/,$$md_val);
        $$md_val = \@array;

        foreach my $tag (@{$$md_val}) {
            unless (exists($data->{'tagmap'}->{$tag})) {
                $data->{'tagmap'}->{$tag} = {};
            }
            $data->{'tagmap'}->{$tag}->{$keyname} = undef;
        }
    }

    $data->{'keys'}->{$keyname}->{$location}->{$$md_key} = $$md_val;
}

#
# Given a list of spine keys, process them for metadata
#
sub process_changed_keys
{
    my ($keys, $rev, $repo, $data) = @_;

    # As far as I can tell, there's no "get_file" equivalent
    # in SVN::Fs or any other "local" module and there's
    # no equivalent of the functions we use in SVN::Fs in SVN::Ra
    # so despite the fact they're a bit overlapping, we really do
    # need both.
    my $ra = new SVN::Ra($repo);
    my $fh = new IO::Scalar;

    foreach my $k (keys(%{$keys})) {
        debug("------KEY: $k");
        eval {$ra->get_file($k, $rev, $fh);};
        next if ($@ || !defined($fh->sref));
        foreach my $line (split(/\n/,${$fh->sref})) {
            next unless ($line =~ /^# spine_(\w+):\s*(.*)$/);
            # md == metadata
            my $md_key = $1;
            my $md_val = $2;
            process_val($data, $k, \$md_key, \$md_val);
            debug("Adding $k for $md_key\n");
        }
        $fh->close();
    }
    debug("Updating DB rev to $rev");
    $data->{rev} = $rev;
}

#
# Flush updated metadata to the DB
#
sub update_data_file
{
    my $data = shift;
    YAML::Syck::DumpFile(DATA_FILE, $data);
}

sub print_html_headers
{
    my $fh = shift;

    print $fh "<html><body>\n";
}

sub print_html_footers
{
    my $fh = shift;

    print $fh "</body></html>\n";
}

sub href_array
{
    my ($array_ptr, $prefix) = @_;
    my @array = map {
        '<a href="#' . $prefix . $_ . '">' . $_ . '</a>';
        } @{$array_ptr};
    my $str = join(', ', @array);
    return \$str;
}

sub print_key_table
{
    my ($fh, $data) = @_;

    print $fh "<h2>Key Table</h2>\n";
    print $fh 'This table lists all keys that have metadata associated with'
        . ' them and their locations, descriptions, tags, and other'
        . ' medatadata. Tags are hyperlinked to their row in the tag table'
        . " below.\n<p>";
    print $fh "<table border=1 cellpadding=5>\n";
    print $fh '<tr><th>key</th><th>location</th><th>description</th>'
        . '<th>tags</th><th>other</th>' . "\n";

    foreach my $key (keys(%{$data->{'keys'}})) {
        my $key_p = $data->{'keys'}->{$key};
        my $num_locs = scalar(keys(%{$key_p}));
        my $rowspan = '';
        if ($num_locs > 1) {
            $rowspan = " rowspan=$num_locs";
        }
        print $fh "<tr>\n<td$rowspan><a name=\"SK_$key\">$key</a></td>";
        my $c = 0;
        foreach my $loc (keys(%{$key_p})) {
            unless ($c == 0) {
                print $fh '<tr>';
            }
            my $loc_p = $key_p->{$loc};
            my $description = exists($loc_p->{'description'})
                ? $loc_p->{'description'} : '';
            my $tags = exists($loc_p->{'tags'})
                ? ${href_array($loc_p->{'tags'}, 'ST_')} : '';
            print $fh "<td>$loc</td><td>"
                . "$description</td><td>$tags</td><td>";
            foreach my $md (keys(%{$loc_p})) {
                next if ($md =~ /^description|tags$/);
                print $fh "$md: $loc_p->{$md} ";
            }
            print $fh "</td></tr>\n";
            $c++;
        }
    }

    print $fh "</table>\n";
}

sub print_tag_table
{
    my ($fh, $data) = @_;

    print $fh "<h2>Tag Table</h2>\n";
    print $fh 'This table lists all tags that have been used and the keys'
        . ' that have that tag associated with them. The keys are hyperlinked'
        . " to their row in the key table above.\n<p>";
    print $fh "<table border=1 cellpadding=5>\n";
    print $fh "<tr><th>tag</th><th>keys</th></tr>\n";
    foreach my $tag (keys(%{$data->{'tagmap'}})) {
        print $fh '<tr><td><a name="ST_' . $tag . '">' . "$tag</a></td><td>"
            . ${href_array([ keys(%{ $data->{'tagmap'}->{$tag} }) ], 'SK_')};
        print $fh "</td></tr>\n";
    }
    print $fh "</table>\n";
}

sub dump_html
{
    my $data = shift;

    my $fh = new IO::Handle;
    open($fh, '>' . HTML_FILE)
        || die('Failed to open ' . HTML_FILE . ": $!");

    print_html_headers($fh);

    print_key_table($fh, $data);
    print_tag_table($fh, $data);

    # Quick hack to be able to test the internal-href's on a short page.
    print $fh <<EOF
<br><br>
<br><br>
<br><br>
<br><br>
<br><br>
<br><br>
<br><br>
<br><br>
<br><br>
<br><br>
<br><br>
<br><br>
<br><br>
<br><br>
<br><br>
<br><br>
<br><br>
<br><br>
<br><br>
EOF
;

    print_html_footers($fh);

    close($fh);
}
    

#
# MAIN
#

# Some basic variables
my $repo_path = REPO_PATH;
my $repo = 'file://' . $repo_path;
my $rev = shift;

# Make sure we have a revision
unless (defined($rev)) {
    print STDERR "No revision passed in!\n";
    exit 1;
}

# Read in current metadata DB
my $data = read_existing_data();

# Get our base revision from there
my $base_rev = $data->{rev};

# Make sure we have something to do
if ($base_rev == $rev) {
    debug("Base rev and rev are the same");
    exit;
} elsif ($base_rev > $rev) {
    print("Going back in time is bad! No, I will not! You cannot make me!\n");
    exit 1;
}
debug("base_rev: $base_rev, rev: $rev");

# Generate our delta
my $editor = generate_delta($repo_path, $base_rev, $rev);

# Grab just the delta we care about
my $keys = grab_config_keys($editor);

# Free tons of memory...
$editor->{changes} = undef;

# Make sure there's still something to do
if (scalar(keys(%$keys)) == 0) {
	debug("No keys changed");
	exit;
}

# Update our structure of metadata
process_changed_keys($keys, $rev, $repo, $data);

# Write HTML
dump_html($data);

# Write the metadata back to our DB
update_data_file($data);


